Visual Basic Toolbox/Visual Basic Toolbox (P.I.E.)(1996).ISO/math/random/frmrand.frm

Visual Basic Form | 1994-10-31 | 7.8 KB | 250 lines

VERSION 2.00
Begin Form Random
   BackColor       =   &H00C0C0C0&
   Caption         =   "Random Number Generator"
   ClientHeight    =   4020
   ClientLeft      =   1965
   ClientTop       =   1620
   ClientWidth     =   4590
   Height          =   4425
   Icon            =   FRMRAND.FRX:0000
   Left            =   1905
   LinkTopic       =   "Form1"
   ScaleHeight     =   4020
   ScaleWidth      =   4590
   Top             =   1275
   Width           =   4710
   Begin TextBox txtValue
      Height          =   285
      Left            =   2580
      TabIndex        =   1
      Top             =   660
      Width           =   1095
   End
   Begin TextBox txtMin
      Height          =   285
      Left            =   2580
      TabIndex        =   2
      Top             =   1860
      Width           =   1095
   End
   Begin TextBox txtMax
      Height          =   285
      Left            =   2580
      TabIndex        =   3
      Top             =   2460
      Width           =   1095
   End
   Begin CommandButton cmdGenerate
      Caption         =   "&Generate"
      Height          =   375
      Left            =   1680
      TabIndex        =   4
      Top             =   3360
      Width           =   1335
   End
   Begin Shape Shape1
      Height          =   2775
      Left            =   480
      Top             =   300
      Width           =   3615
   End
   Begin Label Label1
      BackColor       =   &H00C0C0C0&
      Caption         =   "Number of Values"
      Height          =   375
      Left            =   900
      TabIndex        =   0
      Top             =   660
      Width           =   1335
   End
   Begin Label Label2
      BackColor       =   &H00C0C0C0&
      Caption         =   "Minimum Value"
      Height          =   375
      Left            =   900
      TabIndex        =   5
      Top             =   1860
      Width           =   1335
   End
   Begin Label Label3
      BackColor       =   &H00C0C0C0&
      Caption         =   "Maximum Value"
      Height          =   375
      Left            =   900
      TabIndex        =   6
      Top             =   2460
      Width           =   1335
   End
Option Explicit
    Dim sMsg As String
Sub cmdGenerate_Click ()
    'Install error handler
    On Error GoTo UnexpectedOops
    'Test for valid range
    If Val(TxtMax.Text) <= Val(TxtValue.Text) + Val(TxtMin.Text) Then
        TxtMax.SetFocus
        sMsg = "Range must be larger than the number of values generated."
        MsgBox sMsg, 64, "Error"
        sMsg = ""
        Exit Sub
    End If
    ReDim numbers(1 To TxtValue.Text) As Integer
    Dim I As Integer, n As Integer, temp As Integer
    Randomize       ' seed random number generator
    I = 1
    Do
                    ' generate random number between Min and Max
        temp = Int(Rnd(1) * ((TxtMax.Text - TxtMin.Text) + 1) + TxtMin.Text)
        If I = 1 Then  ' don't test if first number (will be = to itself)
            numbers(I) = temp
            I = I + 1
        Else
            For n = 1 To I - 1
                If numbers(n) = temp Then   ' check all numbers for duplicates
                    Exit For
                End If
            Next n
            If numbers(n) <> temp Then      ' temp is unique
                numbers(I) = temp
                I = I + 1                   ' advance counter
            Else
                ' do nothing, don't save temp to numbers() and
                ' don't advance I.
                ' go through loop again to search for a unique number
            End If
        End If
Loop While I <= TxtValue.Text       ' repeat until you have enough unique numbers
    ' Generate message box to display numbers
For I = 1 To UBound(numbers)
    sMsg = sMsg + Str$(numbers(I)) & ", "
Next I
MsgBox sMsg, 64, "Unique Random Numbers"
sMsg = ""
Exit Sub
UnexpectedOops:
    MsgBox Error$(Err)
    Exit Sub
End Sub
Sub DrawFrame (TargetControl As Control, FrameWidth, FrameStyle)
' Function: Draw a 3D outline around a control.
' Syntax: DrawFrame Control, Width, Style
' Control = name of control the outline should
'           be drawn around
' Width   = width of the outline
' Style   = Raised or Sunken look
'           0 = Raised
'           1 = Sunken
' Example: DrawFrame Text1, 2, 1
' gives a sunken 3D look to text1
    Dim lft%, Rite%, Btm%, Tp%
    Dim LftLine%, BtmLine%
        'Determine style of outline
    Select Case FrameStyle
        Case 0                  'Raised
            LftLine = 15
            BtmLine = 0
        Case 1                  'Sunken
            LftLine = 0
            BtmLine = 15
    End Select
        'Calculate coordinates of outline
    lft = TargetControl.Left
    Rite = TargetControl.Left + TargetControl.Width
    Tp = TargetControl.Top
    Btm = TargetControl.Top + TargetControl.Height
    TargetControl.Parent.DrawWidth = FrameWidth

        'Draw Top line
    TargetControl.Parent.Line (lft, Tp)-(Rite, Tp), QBColor(LftLine)
        'Draw Left line
    TargetControl.Parent.Line (lft, Tp)-(lft, Btm), QBColor(LftLine)
        'Draw Bottom line
    TargetControl.Parent.Line (lft, Btm)-(Rite, Btm), QBColor(BtmLine)
        'Draw Right Line
    TargetControl.Parent.Line (Rite, Tp)-(Rite, Btm), QBColor(BtmLine)
End Sub
Sub Form_Paint ()
    DrawFrame TxtValue, 2, 1
    DrawFrame TxtMin, 2, 1
    DrawFrame TxtMax, 2, 1
End Sub
Sub Form_Unload (Cancel As Integer)
    About.Show
End Sub
Sub txtMax_KeyPress (keyascii As Integer)
    If keyascii < Asc("0") Or keyascii > Asc("9") Then
        keyascii = 0            ' cancel the character
        Beep                    ' sound error signal
    End If
End Sub
Sub txtMax_LostFocus ()
    If TxtMax.Text = "" Then
        TxtMax.SetFocus
        sMsg = "Please enter a Maximum value."
        MsgBox sMsg, 64, "Error"
        sMsg = ""
        Exit Sub
    End If
    If Val(TxtMax.Text) <= Val(TxtMin.Text) Then
        TxtMax.SetFocus
        sMsg = "Maximum value must be greater than minimum value."
        MsgBox sMsg, 64, "Error"
        sMsg = ""
        Exit Sub
    End If
    If Val(TxtMax.Text) <= Val(TxtValue.Text) + Val(TxtMin.Text) Then
        TxtMax.SetFocus
        sMsg = "Range must be larger than the number of values generated."
        MsgBox sMsg, 64, "Error"
        sMsg = ""
        Exit Sub
    End If
    If Val(TxtMax.Text) >= 32767 Then
        sMsg = "Number must be less than 32,767."
        Beep
        MsgBox sMsg, 64, "Error"
        TxtMax.SetFocus
        sMsg = ""
        Exit Sub
    End If
End Sub
Sub txtMin_KeyPress (keyascii As Integer)
    If keyascii < Asc("0") Or keyascii > Asc("9") Then
        keyascii = 0            ' cancel the character
        Beep                    ' sound error signal
    End If
End Sub
Sub txtMin_LostFocus ()
    If TxtMin.Text = "" Then
        TxtMin.SetFocus
        sMsg = "Please enter a Minimum value."
        MsgBox sMsg, 64, "Error"
        sMsg = ""
        Exit Sub
    End If
    If Val(TxtMin.Text) >= 32767 Then
        sMsg = "Number must be less than 32,767."
        Beep
        MsgBox sMsg, 64, "Error"
        TxtMin.SetFocus
        sMsg = ""
        Exit Sub
    End If
End Sub
Sub txtValue_KeyPress (keyascii As Integer)
    If keyascii < Asc("0") Or keyascii > Asc("9") Then
        keyascii = 0            ' cancel the character
        Beep                    ' sound error signal
    End If
End Sub
Sub txtValue_LostFocus ()
    If TxtValue.Text = "" Then
        TxtValue.SetFocus
        sMsg = "Please enter a number of values to generate."
        MsgBox sMsg, 64, "Error"
        sMsg = ""
        Exit Sub
    End If
End Sub